home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / cg.lha / cg / src / mod3.puma < prev    next >
Text File  |  1992-11-24  |  13KB  |  443 lines
  1. /* Ich, Doktor Josef Grosch, Informatiker, 23.5.1989 */
  2.  
  3. TRAFO EvalMod
  4. TREE Tree
  5. PUBLIC EvalDefMod EvalImplMod EvalImplHead GenEvaluator
  6.  
  7. EXPORT { VAR Class: Tree.tTree; }
  8.  
  9. GLOBAL {
  10.  
  11. FROM SYSTEM    IMPORT ADR;
  12. FROM IO        IMPORT WriteS, WriteNl;
  13. FROM StringMem    IMPORT WriteString;
  14. FROM Texts    IMPORT WriteText;
  15. FROM Sets    IMPORT IsElement;
  16. FROM TreeMod1    IMPORT BSS;
  17. FROM TreeMod2    IMPORT WriteLine;
  18. FROM EvalMod3    IMPORT ToBit0;
  19.  
  20. FROM Tree    IMPORT
  21.    NoTree    , tTree        , Child        , NoCodeClass    ,
  22.    Computed    , Reverse    , Write        , Read        ,
  23.    Inherited    , Synthesized    , Input        , Output    ,
  24.    CopyDef    , CopyUse    , Thread    , Virtual    ,
  25.    Test        , Left        , Right        ,
  26.    NonBaseComp    , First        , Dummy        , Trace        ,
  27.    Options    , TreeRoot    , iModule    , iMain        ,
  28.    itTree    , ForallClasses    , f        , WI    , WN    ,
  29.    IdentifyClass, IdentifyAttribute, GrammarClass, cOAG        ,
  30.    MaxVisit    ;
  31.  
  32. VAR
  33.    n        : SHORTCARD;
  34.    Node        ,
  35.    Attr        ,
  36.    ChildsClass    : tTree;
  37. }
  38.  
  39. PROCEDURE EvalDefMod (t: Tree)
  40.     
  41. Ag (..) :- {
  42.     !DEFINITION MODULE ! WI (EvalName); !;!
  43.     !!
  44.     !IMPORT ! WI (iMain); !;!
  45.     WriteLine (EvalCodes^.Codes.ImportLine);
  46.     WriteText (f, EvalCodes^.Codes.Import);
  47.     Node := Modules;
  48.     WHILE Node^.Kind = Tree.Module DO
  49.        WriteLine (Node^.Module.EvalCodes^.Codes.ImportLine);
  50.        WriteText (f, Node^.Module.EvalCodes^.Codes.Import);
  51.        Node := Node^.Module.Next;
  52.     END;
  53.     WriteLine (EvalCodes^.Codes.ExportLine);
  54.     WriteText (f, EvalCodes^.Codes.Export);
  55.     Node := Modules;
  56.     WHILE Node^.Kind = Tree.Module DO
  57.        WriteLine (Node^.Module.EvalCodes^.Codes.ExportLine);
  58.        WriteText (f, Node^.Module.EvalCodes^.Codes.Export);
  59.        Node := Node^.Module.Next;
  60.     END;
  61.     !!
  62.     !PROCEDURE Eval (yyt: ! WI (iMain); !.! WI (itTree); !);!
  63.     !PROCEDURE Begin! WI (EvalName); !;!
  64.     !PROCEDURE Close! WI (EvalName); !;!
  65.     !!
  66.     !END ! WI (EvalName); !.!
  67. }; .
  68.  
  69. PROCEDURE EvalImplHead (t: Tree)
  70.     
  71. Ag (..) :- {
  72.     !# define DEP(a, b) a!
  73.     !# define SELF yyt!
  74.     !IMPLEMENTATION MODULE ! WI (EvalName); !;!
  75.     !!
  76.     !IMPORT SYSTEM, ! WI (iMain); !;!
  77.       IF IsElement (ORD ('Y'), Options) OR
  78.          IsElement (ORD ('Z'), Options) THEN
  79.     !IMPORT Layout, Strings, Idents, Texts, Sets;!
  80.       END;
  81.       IF IsElement (ORD ('Y'), Options) OR
  82.          IsElement (ORD ('Z'), Options) OR
  83.          IsElement (ORD ('L'), Options) OR
  84.          IsElement (ORD ('9'), Options) THEN
  85.     !IMPORT IO;!
  86.       END;
  87.       IF IsElement (ORD ('9'), Options) THEN
  88.     !IMPORT General;!
  89.       END;
  90.     WriteLine (EvalCodes^.Codes.GlobalLine);
  91.     WriteText (f, EvalCodes^.Codes.Global);
  92.     Node := Modules;
  93.     WHILE Node^.Kind = Tree.Module DO
  94.        WriteLine (Node^.Module.EvalCodes^.Codes.GlobalLine);
  95.        WriteText (f, Node^.Module.EvalCodes^.Codes.Global);
  96.        Node := Node^.Module.Next;
  97.     END;
  98.     !!
  99.     !VAR yyb    : BOOLEAN;!
  100.       IF IsElement (ORD ('X'), Options) THEN
  101.     @# include "yy@ WI (iModule); @.w"@
  102.     !# define yyWrite! WI (iMain); !(a) ! WI (iMain); !.Write! WI (iMain); ! (yyf, a)!
  103.     !!
  104.     !VAR yyf    : IO.tFile;!
  105.     !!
  106.     !PROCEDURE yyWriteHex (VAR yyx: ARRAY OF SYSTEM.BYTE);!
  107.     ! VAR yyi    : INTEGER;!
  108.     ! BEGIN!
  109.     !  IF yyTrace THEN!
  110.     !   FOR yyi := 0 TO INTEGER (HIGH (yyx)) DO!
  111.     !    IO.WriteN (yyf, ORD (CHAR (yyx [yyi])), 2, 16);!
  112.     !    IO.WriteC (yyf, ' ');!
  113.     !   END;!
  114.     !  END;!
  115.     ! END yyWriteHex;!
  116.     !!
  117.     !PROCEDURE yyWriteNl;!
  118.     ! BEGIN IF yyTrace THEN!
  119.     !  IO.WriteNl (IO.StdOutput); IO.WriteFlush (IO.StdOutput);!
  120.     ! END; END yyWriteNl;!
  121.       END;
  122.       IF IsElement (ORD ('Y'), Options) OR
  123.          IsElement (ORD ('Z'), Options) THEN
  124.     !!
  125.     !CONST yyTrace = TRUE;!
  126.     !!
  127.     !PROCEDURE yyWriteS (yys: ARRAY OF CHAR);!
  128.     ! BEGIN!
  129.     !  IO.WriteS (IO.StdOutput, yys); Layout.WriteSpaces (IO.StdOutput, 15 - INTEGER (HIGH (yys)));!
  130.     ! END yyWriteS;!
  131.     !!
  132.     !PROCEDURE yyWriteType (yyt: ! WI (iMain); !.! WI (itTree); !);!
  133.     ! BEGIN!
  134.     !  CASE yyt^.Kind OF!
  135.     ForallClasses (Classes, WriteType);
  136.     !  ELSE!
  137.     !  END;!
  138.     ! END yyWriteType;!
  139.       END;
  140.       IF IsElement (ORD ('X'), Options) THEN
  141.     !!
  142.     !PROCEDURE yyWriteEval (yyt: ! WI (iMain); !.! WI (itTree); !; yys: ARRAY OF CHAR);!
  143.     ! BEGIN!
  144.     !  IF yyTrace THEN!
  145.     !   yyWriteType (yyt);!
  146.     !   IO.WriteS (IO.StdOutput, ' e ');!
  147.     !   IO.WriteS (IO.StdOutput, yys);!
  148.     !   Layout.WriteSpaces (IO.StdOutput, 23 - INTEGER (HIGH (yys)));!
  149.     !   IO.WriteS (IO.StdOutput, ' = ');!
  150.     !   IO.WriteFlush (IO.StdOutput);!
  151.     !  END;!
  152.     ! END yyWriteEval;!
  153.       ELSIF IsElement (ORD ('Y'), Options) THEN
  154.     !!
  155.     !PROCEDURE yyWriteEval (yyt: ! WI (iMain); !.! WI (itTree); !; yys: ARRAY OF CHAR);!
  156.     ! BEGIN!
  157.     !  IF yyTrace THEN!
  158.     !   yyWriteType (yyt);!
  159.     !   IO.WriteS (IO.StdOutput, ' e ');!
  160.     !   IO.WriteS (IO.StdOutput, yys);!
  161.     !   IO.WriteNl (IO.StdOutput);!
  162.     !   IO.WriteFlush (IO.StdOutput);!
  163.     !  END;!
  164.     ! END yyWriteEval;!
  165.       END;
  166.       IF IsElement (ORD ('Z'), Options) THEN
  167.     !!
  168.     !PROCEDURE yyWriteVisit (yyt: ! WI (iMain); !.! WI (itTree); !; yys: ARRAY OF CHAR);!
  169.     ! BEGIN!
  170.     !  IF yyTrace THEN!
  171.     !   yyWriteType (yyt);!
  172.     !   IO.WriteS (IO.StdOutput, ' v ');!
  173.     !   IO.WriteS (IO.StdOutput, yys);!
  174.     !   IO.WriteNl (IO.StdOutput);!
  175.     !   IO.WriteFlush (IO.StdOutput);!
  176.     !  END;!
  177.     ! END yyWriteVisit;!
  178.     !!
  179.     !PROCEDURE yyVisitParent (yyt: ! WI (iMain); !.! WI (itTree); !);!
  180.     ! BEGIN yyWriteVisit (yyt, 'parent'); END yyVisitParent;!
  181.       END;
  182. }; .
  183.  
  184. PROCEDURE EvalImplMod (t: Tree)
  185.     
  186. Ag (..) :- {
  187.     EvalImplHead (t);
  188.       IF NOT IsElement (ORD ('9'), Options) THEN
  189.     !!
  190.     !PROCEDURE Eval (yyt: ! WI (iMain); !.! WI (itTree); !);!
  191.     ! BEGIN ! 
  192.     IF MaxVisit > 0 THEN !yyVisit1 (yyt); ! END;
  193.     !END Eval;!
  194.       ELSE
  195.     !!
  196.     !VAR xxStack: CARDINAL;!
  197.     !!
  198.     !PROCEDURE Eval (yyt: ! WI (iMain); !.! WI (itTree); !);!
  199.     ! VAR xxHigh: BOOLEAN;!
  200.     ! BEGIN!
  201.     !  xxStack := MAX (INTEGER);!
  202.     IF MaxVisit > 0 THEN
  203.     !  yyVisit1 (yyt);!
  204.     END;
  205.     !  IO.WriteS (IO.StdOutput, 'Stacksize ');!
  206.     !  IO.WriteI (IO.StdOutput, CARDINAL (SYSTEM.ADR (xxHigh)) - xxStack, 0);!
  207.     !  IO.WriteNl (IO.StdOutput);!
  208.     ! END Eval;!
  209.       END;
  210.     !!
  211.     FOR n := 1 TO MaxVisit DO
  212.        !PROCEDURE yyVisit! WN (n); ! (yyt: ! WI (iMain); !.! WI (itTree); !);!
  213.        WriteLine (EvalCodes^.Codes.LocalLine);
  214.        WriteText (f, EvalCodes^.Codes.Local);
  215.        Node := Modules;
  216.        WHILE Node^.Kind = Tree.Module DO
  217.           WriteLine (Node^.Module.EvalCodes^.Codes.LocalLine);
  218.           WriteText (f, Node^.Module.EvalCodes^.Codes.Local);
  219.           Node := Node^.Module.Next;
  220.        END;
  221.       IF IsElement (ORD ('9'), Options) THEN
  222.        ! VAR xxLow: BOOLEAN;!
  223.        ! BEGIN!
  224.        !  xxStack := General.Min (xxStack, CARDINAL (SYSTEM.ADR (xxLow)));!
  225.       ELSE
  226.        ! BEGIN!
  227.       END;
  228.        !  CASE yyt^.Kind OF!
  229.        IF cOAG IN GrammarClass THEN        (* generate evaluator    *)
  230.           ForallClasses (Classes, GenEvaluator);
  231.        END;
  232.        !  ELSE!
  233.       IF IsElement (ORD ('Z'), Options) THEN
  234.        !   yyVisitParent (yyt);!
  235.       END;
  236.        !  END;!
  237.        ! END yyVisit! WN (n); !;!
  238.        !!
  239.     END;
  240.     !PROCEDURE Begin! WI (EvalName); !;!
  241.     ! BEGIN!
  242.     WriteLine (EvalCodes^.Codes.BeginLine);
  243.     WriteText (f, EvalCodes^.Codes.Begin);
  244.     Node := Modules;
  245.     WHILE Node^.Kind = Tree.Module DO
  246.        WriteLine (Node^.Module.EvalCodes^.Codes.BeginLine);
  247.        WriteText (f, Node^.Module.EvalCodes^.Codes.Begin);
  248.        Node := Node^.Module.Next;
  249.     END;
  250.     ! END Begin! WI (EvalName); !;!
  251.     !!
  252.     !PROCEDURE Close! WI (EvalName); !;!
  253.     ! BEGIN!
  254.     WriteLine (EvalCodes^.Codes.CloseLine);
  255.     WriteText (f, EvalCodes^.Codes.Close);
  256.     Node := Modules;
  257.     WHILE Node^.Kind = Tree.Module DO
  258.        WriteLine (Node^.Module.EvalCodes^.Codes.CloseLine);
  259.        WriteText (f, Node^.Module.EvalCodes^.Codes.Close);
  260.        Node := Node^.Module.Next;
  261.     END;
  262.     ! END Close! WI (EvalName); !;!
  263.     !!
  264.     !BEGIN!
  265.       IF IsElement (ORD ('X'), Options) THEN
  266.     ! yyf := IO.StdOutput;!
  267.       END;
  268.     !END ! WI (EvalName); !.!
  269. }; .
  270.  
  271.  
  272. PROCEDURE WriteType (t: Tree)
  273.  
  274. Class (..) :-
  275.     NoCodeClass * Properties = {{}};
  276.     Trace IN Properties;
  277.     !| ! WI (TreeRoot^.Ag.TreeName); !.! WI (Name); !: yyWriteS ('! WI (Name); !');!
  278.     .
  279.  
  280. PROCEDURE GenEvaluator (t: Tree)
  281.  
  282. Class (..) :-
  283.     NoCodeClass * Properties = {{}};
  284. {    IF (Generated = InstCount) OR (Visits < n) THEN RETURN; END;
  285.     !| ! WI (TreeRoot^.Ag.TreeName); !.! WI (Name); !:!
  286.     Class := t;
  287.     LOOP
  288.        IF Generated = InstCount THEN EXIT; END;
  289.        INC (Generated);
  290.        WITH Instance^ [Instance^ [Generated].Order] DO
  291.           IF (Left IN Properties) AND (Attribute^.Child.Partition > n) THEN
  292.              DEC (Generated); EXIT;
  293.           END;
  294.           IF ({Inherited, Right, First} <= Properties) AND NOT (Virtual IN Properties) THEN
  295.       IF IsElement (ORD ('X'), Options) AND (Trace IN t^.Class.Properties) THEN
  296.          !yyWriteEval (yyt, '! WI (Selector^.Child.Name); !:! WI (Attribute^.Child.Name); !');!
  297.          IF Action # ADR (Action) THEN GenEvaluator (Action); END; !!
  298.          IF (Attribute^.Kind = Tree.Child) OR (Attribute^.Attribute.Type = itTree) THEN
  299.             !write! WI (itTree);
  300.             ! (yyt^.! WI (Name); !.! WI (Selector^.Child.Name);
  301.             !^.! WI (Selector^.Child.Type); !.! WI (Attribute^.Child.Name); !)!
  302.          ELSE
  303.             !write! WI (Attribute^.Child.Type);
  304.             ! (yyt^.! WI (Name); !.! WI (Selector^.Child.Name);
  305.             !^.! WI (Selector^.Child.Type); !.! WI (Attribute^.Child.Name); !) yyWriteNl;!
  306.          END;
  307.       ELSIF IsElement (ORD ('Y'), Options) AND (Trace IN t^.Class.Properties) THEN
  308.          !yyWriteEval (yyt, '! WI (Selector^.Child.Name); !:! WI (Attribute^.Child.Name); !');!
  309.          IF Action # ADR (Action) THEN GenEvaluator (Action); END;
  310.       ELSE
  311.          IF Action # ADR (Action) THEN GenEvaluator (Action); END;
  312.       END;
  313.           END;
  314.           IF ({Synthesized, Left, First} <= Properties) AND ({Dummy, Virtual} * Properties = {}) THEN
  315.       IF IsElement (ORD ('X'), Options) AND (Trace IN t^.Class.Properties) THEN
  316.          !yyWriteEval (yyt, '! WI (Attribute^.Child.Name); !');!
  317.          IF Action # ADR (Action) THEN GenEvaluator (Action); END; !!
  318.          IF Test IN Properties THEN
  319.             !writeBOOLEAN (yyb) yyWriteNl;!
  320.          ELSIF (Attribute^.Kind = Tree.Child) OR (Attribute^.Attribute.Type = itTree) THEN
  321.             !write! WI (itTree);
  322.             ! (yyt^.! WI (Name); !.! WI (Attribute^.Child.Name); !)! 
  323.          ELSE
  324.             !write! WI (Attribute^.Child.Type);
  325.             ! (yyt^.! WI (Name); !.! WI (Attribute^.Child.Name); !) yyWriteNl;!
  326.          END;
  327.       ELSIF IsElement (ORD ('Y'), Options) AND (Trace IN t^.Class.Properties) THEN
  328.          !yyWriteEval (yyt, '! WI (Attribute^.Child.Name); !');!
  329.          IF Action # ADR (Action) THEN GenEvaluator (Action); END;
  330.       ELSE
  331.          IF Action # ADR (Action) THEN GenEvaluator (Action); END;
  332.       END;
  333.           END;
  334.           IF ({Synthesized, Right, First} <= Properties) AND
  335.          (Attribute^.Child.Partition <= Selector^.Child.Class^.Class.Visits) THEN
  336.       IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
  337.          !yyWriteVisit (yyt, '! WI (Selector^.Child.Name); ! ! 
  338.          WN (Attribute^.Child.Partition); !');!
  339.       END;
  340.          !yyVisit! WN (Attribute^.Child.Partition);
  341.          ! (yyt^.! WI (Name); !.! WI (Selector^.Child.Name); !);!
  342.           END;
  343.        END;
  344.     END;
  345.       IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
  346.     !yyVisitParent (yyt);!
  347.       END;
  348. }; .
  349. Assign (..) :- {
  350.     WriteLine (Pos);
  351.     GenEvaluator (Results); !:=! GenEvaluator (Arguments); !;!
  352. }; .
  353. Copy (..) :- {
  354.     WriteLine (Pos);
  355.     GenEvaluator (Results); !:=! GenEvaluator (Arguments); !;!
  356. }; .
  357. TargetCode (..) :- {
  358.     WriteLine (Pos);
  359.     GenEvaluator (Code); !!
  360. }; .
  361. Check (..) :- {
  362.     WriteLine (Pos);
  363.     IF Condition # NoTree THEN
  364.       IF IsElement (ORD ('X'), Options) THEN
  365.        !yyb := ! GenEvaluator (Condition); !; IF NOT yyb THEN ! 
  366.       ELSE
  367.        !IF NOT (! GenEvaluator (Condition); !) THEN ! 
  368.       END;
  369.        GenEvaluator (Statement); !!
  370.        IF Actions^.Kind = Tree.Check THEN
  371.           !ELSE!
  372.           GenEvaluator (Actions);
  373.        END;
  374.        ! END;!
  375.     ELSE
  376.       IF IsElement (ORD ('X'), Options) THEN
  377.        !yyb := FALSE; ! 
  378.       END;
  379.        GenEvaluator (Statement); !;!
  380.        GenEvaluator (Actions);
  381.     END;
  382. }; .
  383. Designator (..) :- {
  384.     Attr := IdentifyAttribute (Class, Selector);
  385.     IF Attr # NoTree THEN
  386.        ChildsClass := Attr^.Child.Class;
  387.        Attr := IdentifyAttribute (ChildsClass, Attribute);
  388.        IF NOT (Virtual IN Attr^.Attribute.Properties) THEN
  389.           !yyt^.! WI (Class^.Class.Name); !.! 
  390.           WI (Selector); !^.! WI (ChildsClass^.Class.Name); !.! WI (Attribute);
  391.        END;
  392.     ELSE
  393.        WI (Selector); !:! WI (Attribute);
  394.     END;
  395.     GenEvaluator (Next);
  396. }; .
  397. Ident (..) :- {
  398.     Attr := IdentifyAttribute (Class, Attribute);
  399.     IF Attr # NoTree THEN
  400.        IF NOT (Virtual IN Attr^.Attribute.Properties) THEN
  401.           !yyt^.! WI (Class^.Class.Name); !.! WI (Attribute);
  402.        END;
  403.     ELSE
  404.        WI (Attribute);
  405.     END;
  406.     GenEvaluator (Next);
  407. }; .
  408. Remote (..) :-
  409.    TheClass: Class; k: INTEGER;
  410.    TheClass := IdentifyClass (TreeRoot^.Ag.Classes, Type);
  411. {  IF TheClass # NoTree THEN
  412.       Attr := IdentifyAttribute (TheClass, Attribute);
  413.       IF Attr # NoTree THEN
  414.      WITH Attr^.Attribute DO
  415.         k := ToBit0 (TheClass, AttrIndex);
  416.         IF Synthesized IN Properties THEN
  417.            !REMOTE_SYN (yyIsComp! WN (k DIV BSS); !, ! WN (k MOD BSS); !, yyS! WN (k); !, ! 
  418.            GenEvaluator (Designators); !, ! WI (t^.Remote.Type); !, ! WI (Attribute); !)! 
  419.         ELSIF Inherited IN Properties THEN
  420.            !REMOTE_INH (yyIsComp! WN (k DIV BSS); !, ! WN (k MOD BSS); !, ! WN (k); !, ! 
  421.            GenEvaluator (Designators); !, ! WI (t^.Remote.Type); !, ! WI (Attribute); !)! 
  422.         ELSE
  423.            GenEvaluator (Designators); !^.! WI (t^.Remote.Type); !.! WI (Attribute);
  424.         END;
  425.      END;
  426.       END;
  427.    END;
  428.    GenEvaluator (Next);
  429. }; .
  430. Any (..) :- {
  431.     WriteString (f, Code);
  432.     GenEvaluator (Next);
  433. }; .
  434. Anys (..) :- {
  435.     GenEvaluator (Layouts);
  436.     GenEvaluator (Next);
  437. }; .
  438. LayoutAny (..) :- {
  439.     WriteString (f, Code);
  440.     GenEvaluator (Next);
  441. }; .
  442.  
  443.